unit uDZWinInetUtils;

interface

uses
  SysUtils, Classes, SysConst, Windows, WinInet, Winsock, uDZHttpTypes;

const
  INET_NULL_HANDLE: HINTERNET = nil;
  INTERNET_STATUS_DETECTING_PROXY  =  80;
  INTERNET_STATUS_USER_INPUT_REQUIRED = 140;
  INTERNET_STATUS_COOKIE_SENT = 320;
  INTERNET_STATUS_COOKIE_RECEIVED = 321;
  INTERNET_STATUS_PRIVACY_IMPACTED = 324;
  INTERNET_STATUS_P3P_HEADER = 325;
  INTERNET_STATUS_P3P_POLICYREF = 326;
  INTERNET_STATUS_COOKIE_HISTORY = 327;

  BUFFER_SIZE = 1024;
  
type
  TInternetCookieHistory = packed record
    Accepted, Leashed, Downgraded, Rejected: BOOL;
  end;
  PInternetCookieHistory = ^TInternetCookieHistory;

  TDzInetContextAccess = (caPreconfig, caDirect, caGateway,
    caCustom, caPreconfigNoScript);
    
  TDzInetContextFlag = (cfAsync, cfCache, cfOffline);
  TDzInetContextFlags = set of TDzInetContextFlag;
  
  TDzInetContext = class
  private
    fHandle: HINTERNET;
    fAgent: AnsiString;
    fAccess: TDzInetContextAccess;
    fFlags: TDzInetContextFlags;
    fActive: Boolean;
    procedure SetFlags(const Value: TDzInetContextFlags);
    procedure SetAccess(const Value: TDzInetContextAccess);
    procedure SetAgent(const Value: AnsiString);
    procedure Open;
    procedure Close;
    procedure SetActive(const Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    property Active: Boolean read fActive write SetActive;
    property Handle: HINTERNET read fHandle;
    property Agent: AnsiString read fAgent write SetAgent;
    property Access: TDzInetContextAccess read fAccess write SetAccess;
    property Flags: TDzInetContextFlags read fFlags write SetFlags;
  end;

  TDzInetConnection = class
  private
    fContext: TDzInetContext;
    fOwnedContext: Boolean;
    fConnection: HINTERNET;
    procedure AccquireContext;
    procedure SetContext(const Value: TDzInetContext);
    function GetContext: TDzInetContext;
  protected
    procedure AsyncCallback(Status, InfoLen: DWORD; Info: Pointer);
    function Connect(Host: PChar; Port: Word = INTERNET_DEFAULT_HTTP_PORT;
      Service: DWORD = INTERNET_SERVICE_HTTP; Username: PAnsiChar = nil;
      Password: PAnsiChar = nil; Flags: DWORD = 0;
      pError: PInteger = nil): Boolean;
    procedure OnConnectionCreated(ErrorCode: Integer); virtual; abstract;
    procedure OnResolvingName(Domain: PAnsiChar); dynamic;
    procedure OnNameResolved(Domain: PAnsiChar); dynamic;
    procedure OnConnecting(EndPoint: PSockAddr); dynamic;
    procedure OnConnected(EndPoint: PSockAddr); dynamic;
    procedure OnSendingRequest; dynamic;
    procedure OnRequestSent(BytesSent: Integer); dynamic;
    procedure OnRecvingResponse; dynamic;
    procedure OnResponseRecved(BytesRecved: Integer); dynamic;
    procedure OnCtlRespRecved; dynamic;
    procedure OnPrefetch; dynamic;
    procedure OnDisconnecting; dynamic;
    procedure OnDisconneted; dynamic;
    procedure OnHandleCreated(Error: Integer; Handle: HINTERNET); dynamic;
    procedure OnHandleClosing; dynamic;
    procedure OnDetectingProxy; dynamic;
    procedure OnCallComplete(ReturnValue: Boolean; Error: Integer); dynamic;
    procedure OnRedirect(Url: PAnsiChar); dynamic;
    procedure OnIntermediateResponse; dynamic;
    procedure OnUserInputRequired; dynamic;
    procedure OnStateChange; dynamic;
    procedure OnCookieSent; dynamic;
    procedure OnCookieRecved; dynamic;
    procedure OnPrivacyImpacted; dynamic;
    procedure OnP3PHeader; dynamic;
    procedure OnP3pPolicyRef; dynamic;
    procedure OnCookieHistory(CookieHistory: PInternetCookieHistory); dynamic;
  public
    destructor Destroy; override;
    property Context: TDzInetContext read GetContext write SetContext;
    property Connection: HINTERNET read fConnection;
  end; 

  THttpRequestState = (rsConnect, rsOpenRequest, rsSendHeader, rsSendParam,
    rsRecvHeader, rsRecvContent);

  TProgressEvent = procedure(Sender: TObject; Done, Total: Int64) of object;

  TDzWinInetHttp = class(TDzInetConnection)
  private
    fRequest: HINTERNET;
    fPostContentType: AnsiString;
    fReferrer: AnsiString;
    fIOBufferSize: Integer;
    fIOBuffer: Pointer;
    fCurIOBufferSize: Integer;
    fMethod: AnsiString;
    fPathAndParam: AnsiString;
    fUpStream: TStream;
    fDownStream: TStream;
    ContentLength: DWORD;
    fOnProgress: TProgressEvent;
  private
    CustomHeader: AnsiString;
    InetBuf: TInternetBuffersA;
    fState: THttpRequestState;
  private
    procedure AcquireIOBuffer;
    procedure FreeIOBuffer;
    function GetCustomHeader(PostParamSize: DWORD): AnsiString;
    function PostParam(pError: PInteger = nil): Boolean;
    function ReadContent(pError: PInteger = nil): Boolean;
    procedure GetContentLength;
    procedure SetIOBufferSize(const Value: Integer);
  protected
    function OpenRequest(pError: PInteger = nil): Boolean;
    function SendRequest(pError: PInteger = nil): Boolean;
    function EndRequest(pError: PInteger = nil): Boolean;
    procedure OnConnectionCreated(ErrorCode: Integer); override;
    procedure OnRequestSent(BytesSent: Integer); override;
    procedure OnResponseRecved(BytesRecved: Integer); override;
    procedure OnHandleCreated(Error: Integer; Handle: HINTERNET); override;
    procedure OnCallComplete(ReturnValue: Boolean; Error: Integer); override;
  public
    constructor Create;
    destructor Destroy; override;
    
    procedure DoRequest(Method, Host: PAnsiChar; Path: AnsiString;
      Request, Response: TStream;
      Port: Word = INTERNET_DEFAULT_HTTP_PORT;
      Service: DWORD = INTERNET_SERVICE_HTTP;
      Username: PAnsiChar = nil;
      Password: PAnsiChar = nil); overload;

    procedure DoRequest(Method: PAnsichar; Url: AnsiString;
      Request, Response: TStream); overload;

    procedure Close;
    procedure Get(const Url: AnsiString; Data: TStream); overload;
    function Get(const Url: AnsiString): AnsiString; overload;
    procedure Post(const Url: AnsiString; Param, Data: TStream);
    procedure Abort;
    property IOBufferSize: Integer read fIOBufferSize write SetIOBufferSize;
    property Method: AnsiString read fMethod;
    property PathAndParam: AnsiString read fPathAndParam;
    property Referrer: AnsiString read fReferrer write fReferrer;
    property PostContentType: AnsiString read fPostContentType write fPostContentType;
    property OnProgress: TProgressEvent read fOnProgress write fOnProgress;
  end; 

function HttpGet(client: TDzWinInetHttp; const Url: AnsiString): AnsiString; overload;
function HttpGet(const Url: AnsiString): AnsiString; overload;

implementation

procedure RaiseLastOSError(errorCode: Integer);
var
  Error: EOSError;
begin
  if errorCode <> 0 then
    Error := EOSError.CreateResFmt(@SOSError, [errorCode,
      SysErrorMessage(errorCode)])
  else
    Error := EOSError.CreateRes(@SUnkOSError);
  Error.ErrorCode := errorCode;
  raise Error;
end;

procedure InetCallback(hInternet: HINTERNET; dwContext: TDzInetConnection;
  dwInternetStatus: DWORD; lpStatusInfo: Pointer; dwStatusInfoLen: DWORD); stdcall;
begin
  dwContext.AsyncCallback(dwInternetStatus, dwStatusInfoLen, lpStatusInfo);
end;

function HttpGet(client: TDzWinInetHttp; const Url: AnsiString): AnsiString;
var
  ss: TStringStream;
begin
  Result := '';
  ss := TStringStream.Create('');
  try
    client.Get(Url, ss);
    Result := ss.DataString;
  finally
    ss.Free;
  end;
end;

function HttpGet(const Url: AnsiString): AnsiString; overload;
var
  Client: TDzWinInetHttp;
begin
  Client := TDzWinInetHttp.Create;
  try
    Result := HttpGet(Client, Url);
  finally
    Client.Free;
  end;
end;

procedure ResetInetHandle(var handle: HINTERNET);
var
  temp: HINTERNET;
begin
  temp := HINTERNET(InterlockedExchange(Integer(handle), 0));
  if temp <> INET_NULL_HANDLE then InternetCloseHandle(temp);
end;

{ TDzWinInetHttp }

procedure TDzWinInetHttp.Abort;
begin

end;

procedure TDzWinInetHttp.AcquireIOBuffer;
begin
  if fCurIOBufferSize <> fIOBufferSize then
  begin
    if fCurIOBufferSize = 0 then
      fIOBuffer := System.GetMemory(fIOBufferSize)
    else fIOBuffer := System.ReallocMemory(fIOBuffer, fIOBufferSize);
    fCurIOBufferSize := fIOBufferSize;
  end;
end;

procedure TDzWinInetHttp.Close;
begin
  ResetInetHandle(fRequest);
  ResetInetHandle(fConnection);
end;

constructor TDzWinInetHttp.Create;
begin
  fIOBufferSize := BUFFER_SIZE;
end;

destructor TDzWinInetHttp.Destroy;
begin
  Close;
  FreeIOBuffer;
  inherited;
end;

procedure TDzWinInetHttp.DoRequest(Method, Host: PAnsiChar;
  Path: AnsiString; Request, Response: TStream; Port: Word;
  Service: DWORD; Username, Password: PAnsiChar);
var
  LastError: Integer;
begin
  fUpStream := Request;
  fDownStream := Response;
  ContentLength := DWORD(-1);
  fMethod := Method;
  fPathAndParam := Path;
  fState := rsConnect;
  if not Connect(PAnsiChar(Host), Port, Service, PAnsiChar(Username),
    PAnsiChar(Password), 0, @LastError) then
  begin
    if LastError = ERROR_IO_PENDING then Exit
    else RaiseLastOSError(LastError);
  end;
  fState := rsOpenRequest;
  if not OpenRequest(@LastError) then
  begin
    if LastError = ERROR_IO_PENDING then Exit
    else RaiseLastOSError(LastError);
  end;
  fState := rsSendHeader;
  try
    if not SendRequest(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    fState := rsSendParam;
    if Assigned(Request) and not PostParam(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    fState := rsRecvHeader;
    if not EndRequest(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    GetContentLength;
    fState := rsRecvContent;
    if ReadContent(@LastError) then ResetInetHandle(fRequest)
    else begin
      if LastError <> ERROR_IO_PENDING then RaiseLastOSError(LastError);
    end;
  except
    ResetInetHandle(fRequest);
    raise;
  end;
end;

procedure TDzWinInetHttp.DoRequest(Method: PAnsiChar; Url: AnsiString;
  Request, Response: TStream);
var
  UrlComp: TDzURLComponents;
begin
  if not ParseUrl(Url, UrlComp) then
    raise EDzInvalidUrl.CreateFmt('"%s" is not a invalid url', [string(Url)]);
  with UrlComp do
  begin
    DoRequest(Method, PAnsiChar(Host), PathWithParams, Request, Response,
      Port, Ord(Scheme) - 2, PAnsiChar(Username), PAnsiChar(Password));
  end;
end;

function TDzWinInetHttp.EndRequest(pError: PInteger): Boolean;
begin
  Result := HttpEndRequestA(fRequest, nil, 0, DWORD(Self));
  if Result then GetContentLength
  else begin
    if Assigned(pError) then pError^ := GetLastError
    else SysUtils.RaiseLastOSError;
  end;
end;

procedure TDzWinInetHttp.FreeIOBuffer;
begin
  if Assigned(fIOBuffer) then
  begin
    fIOBufferSize := 0;
    System.FreeMemory(fIOBuffer);
  end;
end;

procedure TDzWinInetHttp.Get(const Url: AnsiString; Data: TStream);
begin
  DoRequest('GET', Url, nil, Data);
end;

function TDzWinInetHttp.Get(const Url: AnsiString): AnsiString;
var
  stream: TStringStream;
begin
  stream := TStringStream.Create('');
  try
    Get(Url, stream);
    Result := stream.DataString;
  finally
    stream.Free;
  end;
end;

procedure TDzWinInetHttp.GetContentLength;
var
  TotalRead, BytesRead: DWORD;
begin
  BytesRead := SizeOf(ContentLength);
  if not HttpQueryInfoA(fRequest, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
    @ContentLength, BytesRead, TotalRead) then
  begin
    if GetLastError = ERROR_HTTP_HEADER_NOT_FOUND then
      ContentLength := 0
    else SysUtils.RaiseLastOSError;
  end;
end;

function TDzWinInetHttp.GetCustomHeader(PostParamSize: DWORD): AnsiString;
begin
  if PostParamSize <> 0 then
  begin
    if PostContentType = '' then
      Result := Format('content-length: %d'#13#10#13#10,
        [PostParamSize])
    else
      Result := Format('content-type: %s'#13#10'content-length: %d'#13#10#13#10,
        [PostContentType, PostParamSize]);
  end
  else Result := '';
end;

procedure TDzWinInetHttp.OnConnectionCreated(ErrorCode: Integer);
var
  LastError: Integer;
begin
  if not Assigned(Connection) then
  begin
    Exit;
  end;
  fState := rsOpenRequest;
  if not OpenRequest(@LastError) then
  begin
    if LastError = ERROR_IO_PENDING then Exit
    else RaiseLastOSError(LastError);
  end;
  fState := rsSendHeader;
  try
    if not SendRequest(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    fState := rsSendParam;
    if Assigned(fUpStream) and not PostParam(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    fState := rsRecvHeader;
    if not EndRequest(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    fState := rsRecvContent;
    if ReadContent(@LastError) then
      ResetInetHandle(fRequest)
    else begin
      if LastError <> ERROR_IO_PENDING then
        RaiseLastOSError(LastError);
    end;
  except
    ResetInetHandle(fRequest);
    raise;  
  end;
end;

procedure TDzWinInetHttp.OnHandleCreated(Error: Integer; Handle: HINTERNET);
var
  LastError: Integer;
begin
  if Handle = INET_NULL_HANDLE then
  begin
    Exit;
  end;
  fRequest := Handle;
  fState := rsSendHeader;
  try
    if not SendRequest(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    fState := rsSendParam;
    if Assigned(fUpStream) and not PostParam(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    fState := rsRecvHeader;
    if not EndRequest(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    fState := rsRecvContent;
    if ReadContent(@LastError) then
      ResetInetHandle(fRequest)
    else begin
      if LastError <> ERROR_IO_PENDING then
        RaiseLastOSError(LastError);
    end;
  except
    ResetInetHandle(fRequest);
    raise;  
  end;
end;

procedure TDzWinInetHttp.OnCallComplete(ReturnValue: Boolean; Error: Integer);
var
  LastError: Integer;
begin
  if not ReturnValue then
  begin
    ResetInetHandle(fRequest);
    Exit;
  end;
  try
    if fState = rsSendHeader then
    begin
      fState := rsSendParam;
      if Assigned(fUpStream) and not PostParam(@LastError) then
      begin
        if LastError = ERROR_IO_PENDING then Exit
        else RaiseLastOSError(LastError);
      end;
      fState := rsRecvHeader;
      if not EndRequest(@LastError) then
      begin
        if LastError = ERROR_IO_PENDING then Exit
        else RaiseLastOSError(LastError);
      end;
      fState := rsRecvContent;
    end
    else begin
      GetContentLength;
      fState := rsRecvContent;
    end;
    if ReadContent(@LastError) then
      ResetInetHandle(fRequest)
    else begin
      if LastError <> ERROR_IO_PENDING then
        RaiseLastOSError(LastError);
    end;
  except
    ResetInetHandle(fRequest);
    raise;  
  end;
end;

procedure TDzWinInetHttp.OnRequestSent(BytesSent: Integer);
var
  LastError: Integer;
begin
  if fState = rsSendHeader then Exit;
  try
    if fUpStream.Position <> fUpStream.Size then
    begin
      if not PostParam(@LastError) then
      begin
        if LastError = ERROR_IO_PENDING then Exit
        else RaiseLastOSError(LastError);
      end;
    end;
    if not EndRequest(@LastError) then
    begin
      if LastError = ERROR_IO_PENDING then Exit
      else RaiseLastOSError(LastError);
    end;
    if ReadContent(@LastError) then
      ResetInetHandle(fRequest)
    else begin
      if LastError <> ERROR_IO_PENDING then
        RaiseLastOSError(LastError);
    end;
  except
    ResetInetHandle(fRequest);
    raise;  
  end;
end;

procedure TDzWinInetHttp.OnResponseRecved(BytesRecved: Integer);
var
  LastError: Integer;
begin
  if fState = rsRecvHeader then Exit;
  //SetEvent(hReadEvent);
  try
    if ReadContent(@LastError) then
      ResetInetHandle(fRequest)
    else begin
      if LastError <> ERROR_IO_PENDING then
        RaiseLastOSError(LastError);
    end;
  except
    ResetInetHandle(fRequest);
    raise;  
  end;
end;

function TDzWinInetHttp.OpenRequest(pError: PInteger): Boolean;
var
  AcceptTypes: array [0..1] of PAnsiChar;
begin
  AcceptTypes[0] := '*/*';
  AcceptTypes[1] := nil;
  
  fRequest := HttpOpenRequestA(Connection, PAnsiChar(fMethod),
    PAnsiChar(fPathAndParam), nil, PAnsiChar(fReferrer), @AcceptTypes,
    INTERNET_FLAG_NO_CACHE_WRITE, DWORD(Self));
  Result := fRequest <> INET_NULL_HANDLE;
  if not Result then 
  begin
    if Assigned(pError) then pError^ := GetLastError
    else SysUtils.RaiseLastOSError;
  end
end;

function TDzWinInetHttp.SendRequest(pError: PInteger): Boolean;
begin
  if Assigned(fUpStream) then
    CustomHeader := GetCustomHeader(fUpStream.Size - fUpStream.Position)
  else CustomHeader := GetCustomHeader(0);

  FillChar(InetBuf, SizeOf(InetBuf), 0);
  InetBuf.dwStructSize := SizeOf(InetBuf);
  InetBuf.lpcszHeader := PAnsiChar(CustomHeader);
  InetBuf.dwHeadersLength := Length(CustomHeader);
  if Assigned(fUpStream) then
    InetBuf.dwBufferTotal := fUpStream.Size
  else InetBuf.dwBufferTotal := 0;

  Result := HttpSendRequestEx(fRequest, @InetBuf, nil, 0, DWORD(Self));
  if not Result then
  begin
    if Assigned(pError) then pError^ := GetLastError
    else SysUtils.RaiseLastOSError;
  end
end;

procedure TDzWinInetHttp.SetIOBufferSize(const Value: Integer);
begin
  if Value = 0 then fIOBufferSize := BUFFER_SIZE
  else fIOBufferSize := Value
end;

procedure TDzWinInetHttp.Post(const Url: AnsiString; Param, Data: TStream);
begin
  DoRequest('POST', Url, Param, Data);
end;

function TDzWinInetHttp.PostParam(pError: PInteger): Boolean;
var
  BufSize, BytesWrite: DWORD;
begin
  AcquireIOBuffer;
  while True do
  begin
    BufSize := fUpStream.Read(fIOBuffer^, fCurIOBufferSize);
    if BufSize <= 0 then Break;
    if not InternetWriteFile(fRequest, fIOBuffer, BufSize, BytesWrite) then
    begin
      Result := False;
      if Assigned(pError) then pError^ := GetLastError
      else SysUtils.RaiseLastOSError;
      Exit;
    end;
  end;
  Result := True;
end;

function TDzWinInetHttp.ReadContent(pError: PInteger): Boolean;
var
  TotalRead, BytesRead: DWORD;
begin
  AcquireIOBuffer;
  TotalRead := 0;
  while (ContentLength = 0) or (TotalRead < ContentLength) do
  begin
    if not InternetReadFile(fRequest, fIOBuffer, fCurIOBufferSize, BytesRead) then
    begin
      if Assigned(pError) then pError^ := GetLastError
      else SysUtils.RaiseLastOSError;
      Result := False;
      Exit;
    end;

    if BytesRead = 0 then Break;
    fDownStream.WriteBuffer(fIOBuffer^, BytesRead);
    Inc(TotalRead, BytesRead);
    if Assigned(fOnProgress) then fOnProgress(Self, TotalRead, ContentLength);
  end;
  Result := True;
end;

{ TDzInetContext }

procedure TDzInetContext.Close;
begin
  ResetInetHandle(fHandle);
end;

constructor TDzInetContext.Create;
begin
  fAccess := caPreconfig;
  fAgent := 'DZWinInet';
end;

destructor TDzInetContext.Destroy;
begin
  Close;
  inherited;
end;

procedure TDzInetContext.Open;
  function ContextFlag_SetToInt(const Flags: TDzInetContextFlags): DWORD;
  begin
    if cfAsync in Flags then Result := INTERNET_FLAG_ASYNC
    else Result := 0;
    if cfCache in Flags then Result := Result or INTERNET_FLAG_FROM_CACHE;
    if cfOffline in Flags then Result := Result or INTERNET_FLAG_OFFLINE;
  end;
begin
  if fHandle = INET_NULL_HANDLE then
  begin
    fHandle := InternetOpenA(PAnsiChar(fAgent), DWORD(fAccess), nil, nil,
      ContextFlag_SetToInt(fFlags));
    if fHandle = INET_NULL_HANDLE then SysUtils.RaiseLastOSError
    else if cfAsync in fFlags then
      InternetSetStatusCallback(fHandle, @InetCallback);
  end;
end;

procedure TDzInetContext.SetAccess(const Value: TDzInetContextAccess);
begin
  if not fActive then
    fAccess := Value;
end;

procedure TDzInetContext.SetActive(const Value: Boolean);
begin
  if fActive = Value then Exit;
  if Value then
  begin
    Open;
    fActive := True;
  end
  else begin
    Close;
    fActive := False;
  end;
end;

procedure TDzInetContext.SetAgent(const Value: AnsiString);
begin
  if not fActive then
    fAgent := Value;
end;

procedure TDzInetContext.SetFlags(const Value: TDzInetContextFlags);
begin
  if not fActive then
    fFlags := Value;
end;

{ TDzInetConnection }

procedure TDzInetConnection.AccquireContext;
begin
  if not Assigned(fContext) then 
  begin
    fContext := TDzInetContext.Create;
    fOwnedContext := True;
  end;
end;

procedure TDzInetConnection.AsyncCallback(Status, InfoLen: DWORD; Info: Pointer);
var
  AsyncResult: PInternetAsyncResult;
begin
  AsyncResult := PInternetAsyncResult(Info);
  case Status of
    INTERNET_STATUS_RESOLVING_NAME: OnResolvingName(PAnsiChar(Info));
    INTERNET_STATUS_NAME_RESOLVED: OnNameResolved(PAnsiChar(Info));
    INTERNET_STATUS_CONNECTING_TO_SERVER: OnConnecting(PSockAddr(Info));
    INTERNET_STATUS_CONNECTED_TO_SERVER: OnConnected(PSockAddr(Info));
    INTERNET_STATUS_SENDING_REQUEST: OnSendingRequest;
    INTERNET_STATUS_REQUEST_SENT: OnRequestSent(PInteger(Info)^);
    INTERNET_STATUS_RECEIVING_RESPONSE: OnRecvingResponse;
    INTERNET_STATUS_RESPONSE_RECEIVED: OnResponseRecved(PInteger(Info)^);
    INTERNET_STATUS_CTL_RESPONSE_RECEIVED: OnCtlRespRecved;
    INTERNET_STATUS_PREFETCH: OnPrefetch;
    INTERNET_STATUS_CLOSING_CONNECTION: OnDisconnecting;
    INTERNET_STATUS_CONNECTION_CLOSED: OnDisconneted;
    INTERNET_STATUS_HANDLE_CREATED:
      begin
        if fConnection = INET_NULL_HANDLE then
        begin
          fConnection := HINTERNET(AsyncResult^.dwResult);
          OnConnectionCreated(AsyncResult^.dwError);
        end
        else OnHandleCreated(AsyncResult^.dwError, HINTERNET(AsyncResult^.dwResult));
      end;
    INTERNET_STATUS_HANDLE_CLOSING: OnHandleClosing;
    INTERNET_STATUS_DETECTING_PROXY: OnDetectingProxy;
    INTERNET_STATUS_REQUEST_COMPLETE:
      OnCallComplete(AsyncResult^.dwResult <> 0, AsyncResult^.dwError);
    INTERNET_STATUS_REDIRECT: OnRedirect(PAnsiChar(Info));
    INTERNET_STATUS_INTERMEDIATE_RESPONSE: OnIntermediateResponse;
    INTERNET_STATUS_USER_INPUT_REQUIRED: OnUserInputRequired;
    INTERNET_STATUS_STATE_CHANGE: OnStateChange;
    INTERNET_STATUS_COOKIE_SENT: OnCookieSent;
    INTERNET_STATUS_COOKIE_RECEIVED: OnCookieRecved;
    INTERNET_STATUS_PRIVACY_IMPACTED: OnPrivacyImpacted;
    INTERNET_STATUS_P3P_HEADER: OnP3PHeader;
    INTERNET_STATUS_P3P_POLICYREF: OnP3pPolicyRef;
    INTERNET_STATUS_COOKIE_HISTORY: OnCookieHistory(PInternetCookieHistory(Info));
  end;
end;

function TDzInetConnection.Connect(Host: PChar; Port: Word; Service: DWORD;
  Username, Password: PAnsiChar; Flags: DWORD; pError: PInteger): Boolean;
begin
  if Assigned(fConnection) then
  begin
    Result := True;
    Exit;
  end;
  Context.Open;
  fConnection := InternetConnectA(fContext.Handle, Host, Port,
    Username, Password, Service, Flags, DWORD(Self));
  Result := fConnection <> INET_NULL_HANDLE;
  if not Result then
  begin
    if Assigned(pError) then pError^ := GetLastError
    else SysUtils.RaiseLastOSError;
  end;
end;

destructor TDzInetConnection.Destroy;
begin
  if Assigned(fContext) and fOwnedContext then
    fContext.Free;
  inherited;
end;

function TDzInetConnection.GetContext: TDzInetContext;
begin
  AccquireContext;
  Result := fContext;
end;

procedure TDzInetConnection.OnConnected(EndPoint: PSockAddr);
begin

end;

procedure TDzInetConnection.OnConnecting(EndPoint: PSockAddr);
begin

end;

procedure TDzInetConnection.OnCookieHistory(CookieHistory: PInternetCookieHistory);
begin

end;

procedure TDzInetConnection.OnCookieRecved;
begin

end;

procedure TDzInetConnection.OnCookieSent;
begin

end;

procedure TDzInetConnection.OnCtlRespRecved;
begin

end;

procedure TDzInetConnection.OnDetectingProxy;
begin

end;

procedure TDzInetConnection.OnDisconnecting;
begin

end;

procedure TDzInetConnection.OnDisconneted;
begin

end;

procedure TDzInetConnection.OnHandleClosing;
begin

end;

procedure TDzInetConnection.OnHandleCreated(Error: Integer; Handle: HINTERNET);
begin

end;

procedure TDzInetConnection.OnIntermediateResponse;
begin

end;

procedure TDzInetConnection.OnNameResolved;
begin

end;

procedure TDzInetConnection.OnP3PHeader;
begin

end;

procedure TDzInetConnection.OnP3pPolicyRef;
begin

end;

procedure TDzInetConnection.OnPrefetch;
begin

end;

procedure TDzInetConnection.OnPrivacyImpacted;
begin

end;

procedure TDzInetConnection.OnRecvingResponse;
begin

end;

procedure TDzInetConnection.OnRedirect(Url: PAnsiChar);
begin

end;

procedure TDzInetConnection.OnCallComplete(ReturnValue: Boolean; Error: Integer);
begin

end;

procedure TDzInetConnection.OnRequestSent(BytesSent: Integer);
begin

end;

procedure TDzInetConnection.OnResolvingName;
begin

end;

procedure TDzInetConnection.OnResponseRecved(BytesRecved: Integer);
begin

end;

procedure TDzInetConnection.OnSendingRequest;
begin

end;

procedure TDzInetConnection.OnStateChange;
begin

end;

procedure TDzInetConnection.OnUserInputRequired;
begin

end;

procedure TDzInetConnection.SetContext(const Value: TDzInetContext);
begin
  if (Value = nil) or (fContext = Value) then Exit;
  if Assigned(fContext) and fOwnedContext then
    fContext.Free;
  fContext := Value;
  fOwnedContext := False;
end;

end.
